home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0077_Writing Text in Graphics.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  4KB  |  164 lines
  1. (*
  2. Write a unit, that assigns an text file to the Graphics Screen and then
  3. assign output with this proc, then use rewrite(output) and you can
  4. use write/writeln in Graphics mode as well. Don't forget
  5. Assign(output,'');rewrite(output) or
  6. CrtAssign(output);rewrite(output) when back in Text Mode!
  7. You can even implement read/readln in graphics mode, but this is more
  8.  complicated.
  9. One difference to text mode: use MoveTo instead of GotoXY!
  10.  
  11. I've neither my unit nor the TP manual available just now,
  12. but it works like this (output only!):
  13. *)
  14. unit GrpWrite;
  15.  
  16. interface
  17.  
  18. uses Graph,Dos,BGIFont,BGIDriv;
  19.  
  20. procedure GraphAssign(var F:text);
  21.  
  22. implementation
  23. {$R-,S-}
  24.  
  25. var
  26.   GraphDriver, GraphMode, Error : integer;
  27.   a : string;
  28.  
  29. procedure Abort(Msg : string);
  30. begin
  31.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  32.   Halt(1);
  33. end;
  34.  
  35. {$F+} {DO NOT FORGET}
  36.  
  37. function GraphFlush(var F:TextRec):integer;
  38. begin
  39.   GraphFlush := 0;
  40. end;
  41.  
  42. function GraphClose(var F:TextRec):integer;
  43.  begin
  44.    GraphClose := 0;
  45.  end;       {There's nothing to close}
  46.  
  47.  
  48. function GraphWrite(var F:TextRec):integer;
  49.  var
  50.   s : string;
  51.   P : word;
  52.  begin
  53.  with F do
  54.  begin
  55.    P := 0;
  56.    while P<BufPos do
  57.    begin
  58.      OutText(BufPtr^[P]);
  59.      Inc(P);
  60.    end;
  61.    BufPos := 0;
  62.  end;
  63. {               (may need more than one OutText...)}
  64.   (*... {Clear buffer}*)
  65.   GraphWrite := 0;
  66.  end;
  67.  
  68.  
  69. function GraphOpen(var F:TextRec):integer;
  70.  begin
  71.    { Register all the drivers }
  72.   if RegisterBGIdriver(@CGADriverProc) < 0 then
  73.     Abort('CGA');
  74.   if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
  75.     Abort('EGA/VGA');
  76.   if RegisterBGIdriver(@HercDriverProc) < 0 then
  77.     Abort('Herc');
  78.   if RegisterBGIdriver(@ATTDriverProc) < 0 then
  79.     Abort('AT&T');
  80.   if RegisterBGIdriver(@PC3270DriverProc) < 0 then
  81.     Abort('PC 3270');
  82.  
  83.  
  84.   { Register all the fonts }
  85.   if RegisterBGIfont(@GothicFontProc) < 0 then
  86.     Abort('Gothic');
  87.   if RegisterBGIfont(@SansSerifFontProc) < 0 then
  88.     Abort('SansSerif');
  89.   if RegisterBGIfont(@SmallFontProc) < 0 then
  90.     Abort('Small');
  91.   if RegisterBGIfont(@TriplexFontProc) < 0 then
  92.     Abort('Triplex');
  93.  
  94.   GraphDriver := Detect;                  { autodetect the hardware }
  95.   InitGraph(GraphDriver, GraphMode, '');  { activate graphics }
  96.   if GraphResult <> grOk then             { any errors? }
  97.   begin
  98.     Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));
  99.     Halt(1);
  100.   end;
  101.   with F do
  102.   begin
  103.   Closefunc:=@GraphClose;
  104.   InOutFunc:=@GraphWrite;
  105.   FlushFunc:=@GraphFlush;
  106.   end;
  107.   GraphOpen := 0;
  108. (*  ... {Initialisations, see your TP manual}*)
  109.  end;
  110. {$F-}
  111. procedure GraphAssign;
  112.  begin
  113.   with TextRec(F) do
  114.    begin
  115.      Mode := fmClosed;
  116.      BufSize := SizeOf(Buffer);
  117.      BufPtr := @Buffer;
  118.      Name[0] := #0;
  119.      OpenFunc:= @GraphOpen;
  120.     {You can make some initialisations already here}
  121.    end
  122.  end;
  123. end.
  124. =================WRTGRTST.PAS follows==================
  125. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
  126. {$M 16384,0,655360}
  127. uses Crt,
  128.      Graph,     { library of graphics routines }
  129.      GrWrite;
  130. var
  131.   GraphDriver, GraphMode, Error : integer;
  132.   a : string;
  133.   GrOutput:Text;
  134.  
  135. procedure Abort(Msg : string);
  136. begin
  137.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  138.   Halt(1);
  139. end;
  140.  
  141. begin
  142.  GraphAssign(Output);  {Standard output to graphics screen}
  143.  {$I-}
  144.  rewrite(Output); {actually calls GraphOpen}
  145.   {$I+}
  146.  if IoResult <> 0 then halt;
  147.  
  148. (* ....*)
  149.  MoveTo(65,90);
  150.  a := 'this is a string';
  151.  write('this is an embedded string');   {write to graphics screen}
  152.  MoveTo(65,120);
  153.  write(' and this is the second');
  154.  Close(Output); {nothing shows on the screen until this is executed}
  155.  ReadLn(a);
  156.  CloseGraph;
  157.  {Standard output to text screen}
  158.  Assign(output,'');
  159.  rewrite(output);
  160.  GotoXY(5,20); {THIS WORKS}
  161.  write(a);{nothing happens here}             {write to textscreen}
  162. end.
  163.  
  164.